{
  LX Server module

  Based on modo's SDK lxserver.h which is:

  Copyright (c) 2008-2012 Luxology LLC

  Permission is hereby granted, free of charge, to any person obtaining a
  copy of this software and associated documentation files (the 'Software'),
  to deal in the Software without restriction, including without limitation
  the rights to use, copy, modify, merge, publish, distribute, sublicense,
  and/or sell copies of the Software, and to permit persons to whom the
  Software is furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.   Except as contained
  in this notice, the name(s) of the above copyright holders shall not be
  used in advertising or otherwise to promote the sale, use or other dealings
  in this Software without prior written authorization.

  THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER  AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  FROM,  OF OR  CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  DEALINGS  THE SOFTWARE.
}

{
  Copyright (c) 2012 David Ballesteros and Jameel Halabi

  This unit is part of the BLAISEmodo wrapper,
  which is licensed under the BSD 2-Clause license (see licenses/license.txt).
}


unit Lx_Server;

{$mode objfpc}{$H+}

interface

uses
  Lx_Result, Lx_COM;

const
  LXa_FACTORY          = 'factory'         ;
  LXa_HOSTSERVICE      = 'hostservice'     ;
  LXa_MODULE           = 'module'          ;
  LXa_SERVICEEXTENSION = 'serviceExtension';

  LXsSRV_USERNAME      = 'server.username' ;
  LXsSRV_LICENSE       = 'server.license'  ;
  LXsSRV_OWNER         = 'server.owner'    ;
  LXsSRV_SERIAL        = 'server.serial'   ;

  LXsMOD_SERVER        = 'server'          ;

  LXsSRVEXT_GUID       = 'extension.guid'  ;

  LXu_FACTORY          = '{2431A79E-3412-4B0D-987D-875489466C58}';
  LXu_HOSTSERVICE      = '{525802A6-BF5F-46E9-9863-C03B54A3D908}';
  LXu_MODULE           = '{BD6F0E53-C903-46D3-9211-758558D95CAA}';
  LXu_TAGDESCRIPTION   = '{5582E0EE-D682-47BC-BF3D-FB14D59948C1}';
  LXu_NEEDCONTEXT      = '{7D30408C-74AB-4d87-B71C-C6280883863C}';
  LXu_SERVICEEXTENSION = '{E7C6F1A2-2F31-4FA5-B2EF-421BE159D0D8}';

type
  PLXtTagInfoDesc = ^LXtTagInfoDesc;
  LXtTagInfoDesc = record
    Type_ : PChar;
    Info  : PChar;
    GUID  : PGuid;
  end;

  PServerInfo    = ^TServerInfo       ;
  TServerInfo    = type LXtTagInfoDesc;

  TServerInfoArr = array of TServerInfo;

  TLxServer = class;
  TLxServerClass = class of TLxServer;

  PServerRec = ^TServerRec;
  TServerRec = record
    Name   : ShortString   ;
    Class_ : TLxServerClass;
    Info   : TServerInfoArr;
  end;

  TServerRecArr  = array of TServerRec ;

type
  ILxFactory = interface
  [LXu_FACTORY]
    function Name
             (const Name     : PPChar ) : LxResult;
    function UserName
             (const UserName : PPChar ) : LxResult;
    function ClassGUID
             (      GUID     : PGuid  ) : LxResult;
    function Module
             (const Module   : PPChar ) : LxResult;
    function InfoTag
             (const Type_    : PChar  ;
              const Value    : PPChar ) : LxResult;
    function TagCount
             (      Count    : PUInt32) : LxResult;
    function TagByIndex
             (      Index    : UInt32 ;
              const Type_    : PChar  ;
              const Value    : PPChar ) : LxResult;
    function Spawn
             (  out Obj               ) : LxResult;
  end;

  ILxHostService  = interface
  [LXu_HOSTSERVICE]
    function ScriptQuery
             (  out Obj                 ) : LxResult;
    function LookupServer
             (const ClassName : PChar   ;
              const Name      : PChar   ;
                    AllowLoad : DWord   ;
                out Obj                 ) : LxResult;
    function TestServer
             (const ClassName : PChar   ;
              const Name      : PChar   ) : LxResult;
    function NumServers
             (const ClassName : PChar   ) : UInt32  ;
    function ServerByIndex
             (const ClassName : PChar   ;
                    Index     : UInt32  ;
                out Obj                 ) : LxResult;
    function ServerGetIndex
             (const ClassName : PChar   ;
              const Name      : PChar   ;
                    Index     : PUInt32 ) : LxResult;
    function AddServer
             (      Factory   : IUnknown) : LxResult;
    function DefaultPath
             (const Path      : PPChar  ) : LxResult;
    function SpawnForTagsOnly             : LxResult;
  end;

  ILxModule  = interface
  [LXu_MODULE]
    function Generate
             (const Name : PChar;
              const IID  : PGuid;
                out Obj         ) : LxResult;
    function IsLocked             : UInt32  ;
  end;

  ILxTagDescription = interface
  [LXu_TAGDESCRIPTION]
    function Count                           : UInt32  ;
    function Describe
             (      Index : UInt32         ;
                    Desc  : PLXtTagInfoDesc) : LxResult;
  end;

  ILxNeedContext = interface
  [LXu_NEEDCONTEXT]
    function SetContext
             (      App : IUnknown) : LxResult;
  end;

  ILxServiceExtension = interface
  [LXu_SERVICEEXTENSION]
    procedure Dummy;
  end;


  TLxModule = class(LXtObject, ILxModule        ,
                               ILxTagDescription,
                               ILxNeedContext   )
  public
    function  Generate
              (const Name  : PChar          ;
               const IID   : PGuid          ;
                 out Obj                    ) : LxResult;
    function  IsLocked                        : UInt32  ;

    function  Count                           : UInt32  ;
    function  Describe
              (      Index : UInt32         ;
                     Desc  : PLXtTagInfoDesc) : LxResult;
    function  SetContext
              (      App   : IUnknown       ) : LxResult;
  end;

  { TLxServer }

  TLxServer = class(LXtObject, ILxTagDescription,
                               ILxNeedContext   )
  protected
    FServerInfo : TServerInfoArr;
  public
    class
    function  GetServerType                   : TGuid         ; virtual ;
                                                                abstract;

    constructor
              Create                          ;                 virtual ;
    constructor
              CreateForTags                   ;

    function  Count                           : UInt32        ;
    function  Describe
              (      Index : UInt32         ;
                     Desc  : PLXtTagInfoDesc) : LxResult      ;
    function  SetContext
              (      App   : IUnknown       ) : LxResult      ;
  end;

function  GetService
          (const GUID    : TGuid;
             out Obj            ) : LxResult; overload;
function  GetService
          (const GUID    : TGuid) : Pointer ; overload;

procedure AddServer
          (const Name   : PChar         ;
           const Class_ : TLxServerClass;
           const Info   : array of PChar) ;

implementation

uses
  SysUtils;

var
  AppCache : Pointer;

  ServerTags    : TServerInfoArr;
  ServerRecords : TServerRecArr;

function GetService(const GUID : TGuid;
                      out Obj         ) : LxResult;
begin
  Result := IUnknown(AppCache).QueryInterface(GUID, Obj);
end;

function GetService(const GUID : TGuid) : Pointer;
begin
  IUnknown(AppCache).QueryInterface(GUID, Result);
end;

function TLxModule.Generate(const Name : PChar;
                            const IID  : PGuid;
                              out Obj         ) : LxResult;
var
  Index  : Integer  ;
  Server : TLxServer;
begin
  for Index := 0 to High(ServerRecords) do
    if (CompareStr (Name, ServerRecords[Index].Name ) = 0) and
        IsEqualGUID(IID^, ServerTags[Index].GUID^) then
    begin
      if ILxHostService(GetService
                        (ILxHostService)).SpawnForTagsOnly = LXe_FALSE then
      begin
        Server := ServerRecords[Index].Class_.Create;
        Server.FServerInfo := ServerRecords[Index].Info;
        IUnknown(Server).QueryInterface(IID^, Obj);
      end
      else
      begin
        Server := ServerRecords[Index].Class_.CreateForTags;
        Server.FServerInfo := ServerRecords[Index].Info;
        IUnknown(Server).QueryInterface(IID^, Obj);
      end;

      Exit;
    end;

  Result := LXe_NOTFOUND;
end;

function TLxModule.IsLocked : UInt32;
begin
  Result := 1;
end;

function TLxModule.Count : UInt32;
begin
  Result := High(ServerTags) + 1;
end;

function TLxModule.Describe(Index : UInt32         ;
                            Desc  : PLXtTagInfoDesc) : LxResult;
begin
  Desc^.Type_ := ServerTags[Index].Type_;
  Desc^.Info  := ServerTags[Index].Info ;
  Desc^.GUID  := ServerTags[Index].GUID ;

  Result := LXe_OK;
end;

function TLxModule.SetContext(App : IUnknown) : LxResult;
begin
  if not Assigned(AppCache) then
    AppCache := App;

  Result := LXe_OK;
end;

constructor TLxServer.Create;
begin
end;

constructor TLxServer.CreateForTags;
begin
end;

function TLxServer.Count : UInt32;
begin
  Result := High(FServerInfo) + 1;
end;

function TLxServer.Describe(Index : UInt32         ;
                            Desc  : PLXtTagInfoDesc) : LxResult;
begin
  Desc^.Type_ := FServerInfo[Index].Type_;
  Desc^.Info  := FServerInfo[Index].Info ;

  Result := LXe_OK;
end;

function TLxServer.SetContext(App : IUnknown) : LxResult;
begin
  if not Assigned(AppCache) then
    AppCache := App;

  Result := LXe_OK;
end;

procedure AddServer(const Name   : PChar         ;
                    const Class_ : TLxServerClass;
                    const Info   : array of PChar) ;
var
  NewServerTag : PServerInfo;
  NewServerRec : PServerRec ;
  I            : Integer    ;
begin
  if ServerTags <> nil then
  begin
    SetLength(ServerTags, High(ServerTags) + 2);
    NewServerTag := @ServerTags[High(ServerTags)];
  end
  else
  begin
    SetLength(ServerTags, 1);
    NewServerTag := @ServerTags[0];
  end;

  NewServerTag^.Type_ := LXsMOD_SERVER;
  NewServerTag^.Info  := Name         ;
  NewServerTag^.GUID  := GetMem(SizeOf(TGuid));
  NewServerTag^.GUID^ := Class_.GetServerType;

  if ServerRecords <> nil then
  begin
    SetLength(ServerRecords, High(ServerRecords) + 2);
    NewServerRec := @ServerRecords[High(ServerRecords)];
  end
  else
  begin
    SetLength(ServerRecords, 1);
    NewServerRec := @ServerRecords[0];
  end;

  NewServerRec^.Name   := Name  ;
  NewServerRec^.Class_ := Class_;

  if not Assigned(Info[0]) then
    NewServerRec^.Info := nil
  else
  begin
    SetLength(NewServerRec^.Info, Length(Info) div 2);

    for I := 0 to High(NewServerRec^.Info) do
    begin
      NewServerRec^.Info[I].Type_ := Info[I * 2    ];
      NewServerRec^.Info[I].Info  := Info[I * 2 + 1];
    end;
  end;
end;

end.

